Amiga Plus 2002 #11

home *** CD-ROM | disk | FTP | other *** search

/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / ncurses-5.3 / Ada95 / samples / sample-menu_demo.adb < prev next >

Wrap

Text File | 2002-10-27 | 14.4 KB | 392 lines

------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding Samples -- -- -- -- Sample.Menu_Demo -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright (c) 1998 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- -- "Software"), to deal in the Software without restriction, including -- -- without limitation the rights to use, copy, modify, merge, publish, -- -- distribute, distribute with modifications, sublicense, and/or sell -- -- copies of the Software, and to permit persons to whom the Software is -- -- furnished to do so, subject to the following conditions: -- -- -- -- The above copyright notice and this permission notice shall be included -- -- in all copies or substantial portions of the Software. -- -- -- -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- -- -- -- Except as contained in this notice, the name(s) of the above copyright -- -- holders shall not be used in advertising or otherwise to promote the -- -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en -- Version Control -- $Revision: 1.12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses; use Terminal_Interface.Curses; with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; with Terminal_Interface.Curses.Menus.Menu_User_Data; with Terminal_Interface.Curses.Menus.Item_User_Data; with Sample.Manifest; use Sample.Manifest; with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; with Sample.Menu_Demo.Handler; with Sample.Helpers; use Sample.Helpers; with Sample.Explanation; use Sample.Explanation; package body Sample.Menu_Demo is package Spacing_Demo is procedure Spacing_Test; end Spacing_Demo; package body Spacing_Demo is procedure Spacing_Test is function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean; procedure Set_Option_Key; procedure Set_Select_Key; procedure Set_Description_Key; procedure Set_Hide_Key; package Mh is new Sample.Menu_Demo.Handler (My_Driver); I : Item_Array_Access := new Item_Array' (New_Item ("January", "31 Days"), New_Item ("February", "28/29 Days"), New_Item ("March", "31 Days"), New_Item ("April", "30 Days"), New_Item ("May", "31 Days"), New_Item ("June", "30 Days"), New_Item ("July", "31 Days"), New_Item ("August", "31 Days"), New_Item ("September", "30 Days"), New_Item ("October", "31 Days"), New_Item ("November", "30 Days"), New_Item ("December", "31 Days"), Null_Item); M : Menu := New_Menu (I); Flip_State : Boolean := True; Hide_Long : Boolean := False; type Format_Code is (Four_By_1, Four_By_2, Four_By_3); type Operations is (Flip, Reorder, Reformat, Reselect, Describe); type Change is array (Operations) of Boolean; pragma Pack (Change); No_Change : constant Change := Change'(others => False); Current_Format : Format_Code := Four_By_1; To_Change : Change := No_Change; function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean is begin To_Change := No_Change; if K in User_Key_Code'Range then if K = QUIT then return True; end if; end if; if K in Special_Key_Code'Range then case K is when Key_F4 => To_Change (Flip) := True; return True; when Key_F5 => To_Change (Reformat) := True; Current_Format := Four_By_1; return True; when Key_F6 => To_Change (Reformat) := True; Current_Format := Four_By_2; return True; when Key_F7 => To_Change (Reformat) := True; Current_Format := Four_By_3; return True; when Key_F8 => To_Change (Reorder) := True; return True; when Key_F9 => To_Change (Reselect) := True; return True; when Key_F10 => if Current_Format /= Four_By_3 then To_Change (Describe) := True; return True; else return False; end if; when Key_F11 => Hide_Long := not Hide_Long; declare O : Item_Option_Set; begin for J in I'Range loop Get_Options (I (J), O); O.Selectable := True; if Hide_Long then case J is when 1 | 3 | 5 | 7 | 8 | 10 | 12 => O.Selectable := False; when others => null; end case; end if; Set_Options (I (J), O); end loop; end; return False; when others => null; end case; end if; return False; end My_Driver; procedure Set_Option_Key is O : Menu_Option_Set; begin if Current_Format = Four_By_1 then Set_Soft_Label_Key (8, ""); else Get_Options (M, O); if O.Row_Major_Order then Set_Soft_Label_Key (8, "O-Col"); else Set_Soft_Label_Key (8, "O-Row"); end if; end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Option_Key; procedure Set_Select_Key is O : Menu_Option_Set; begin Get_Options (M, O); if O.One_Valued then Set_Soft_Label_Key (9, "Multi"); else Set_Soft_Label_Key (9, "Singl"); end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Select_Key; procedure Set_Description_Key is O : Menu_Option_Set; begin if Current_Format = Four_By_3 then Set_Soft_Label_Key (10, ""); else Get_Options (M, O); if O.Show_Descriptions then Set_Soft_Label_Key (10, "-Desc"); else Set_Soft_Label_Key (10, "+Desc"); end if; end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Description_Key; procedure Set_Hide_Key is begin if Hide_Long then Set_Soft_Label_Key (11, "Enab"); else Set_Soft_Label_Key (11, "Disab"); end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Hide_Key; begin Push_Environment ("MENU01"); Notepad ("MENU-PAD01"); Default_Labels; Set_Soft_Label_Key (4, "Flip"); Set_Soft_Label_Key (5, "4x1"); Set_Soft_Label_Key (6, "4x2"); Set_Soft_Label_Key (7, "4x3"); Set_Option_Key; Set_Select_Key; Set_Description_Key; Set_Hide_Key; Set_Format (M, 4, 1); loop Mh.Drive_Me (M); exit when To_Change = No_Change; if To_Change (Flip) then if Flip_State then Flip_State := False; Set_Spacing (M, 3, 2, 0); else Flip_State := True; Set_Spacing (M); end if; elsif To_Change (Reformat) then case Current_Format is when Four_By_1 => Set_Format (M, 4, 1); when Four_By_2 => Set_Format (M, 4, 2); when Four_By_3 => declare O : Menu_Option_Set; begin Get_Options (M, O); O.Show_Descriptions := False; Set_Options (M, O); Set_Format (M, 4, 3); end; end case; Set_Option_Key; Set_Description_Key; elsif To_Change (Reorder) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.Row_Major_Order := not O.Row_Major_Order; Set_Options (M, O); Set_Option_Key; end; elsif To_Change (Reselect) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.One_Valued := not O.One_Valued; Set_Options (M, O); Set_Select_Key; end; elsif To_Change (Describe) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.Show_Descriptions := not O.Show_Descriptions; Set_Options (M, O); Set_Description_Key; end; else null; end if; end loop; Set_Spacing (M); Flip_State := True; Pop_Environment; pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1))); Delete (M); Free (I, True); end Spacing_Test; end Spacing_Demo; procedure Demo is -- We use this datatype only to test the instantiation of -- the Menu_User_Data generic package. No functionality -- behind it. type User_Data is new Integer; type User_Data_Access is access User_Data; -- Those packages are only instantiated to test the usability. -- No real functionality is shown in the demo. package MUD is new Menu_User_Data (User_Data, User_Data_Access); package IUD is new Item_User_Data (User_Data, User_Data_Access); function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean; package Mh is new Sample.Menu_Demo.Handler (My_Driver); Itm : Item_Array_Access := new Item_Array' (New_Item ("Menu Layout Options"), New_Item ("Demo of Hook functions"), Null_Item); M : Menu := New_Menu (Itm); U1 : User_Data_Access := new User_Data'(4711); U2 : User_Data_Access; U3 : User_Data_Access := new User_Data'(4712); U4 : User_Data_Access; function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean is Idx : constant Positive := Get_Index (Current (M)); begin if K in User_Key_Code'Range then if K = QUIT then return True; elsif K = SELECT_ITEM then if Idx in Itm'Range then Hide (P); Update_Panels; end if; case Idx is when 1 => Spacing_Demo.Spacing_Test; when others => Not_Implemented; end case; if Idx in Itm'Range then Top (P); Show (P); Update_Panels; Update_Screen; end if; end if; end if; return False; end My_Driver; begin Push_Environment ("MENU00"); Notepad ("MENU-PAD00"); Default_Labels; Refresh_Soft_Label_Keys_Without_Update; Set_Pad_Character (M, '|'); MUD.Set_User_Data (M, U1); IUD.Set_User_Data (Itm (1), U3); Mh.Drive_Me (M); MUD.Get_User_Data (M, U2); pragma Assert (U1 = U2 and U1.all = 4711); IUD.Get_User_Data (Itm (1), U4); pragma Assert (U3 = U4 and U3.all = 4712); Pop_Environment; Delete (M); Free (Itm, True); end Demo; end Sample.Menu_Demo;